home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / datature / pdevbas1 / baseprog.exe / MENU.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-06-01  |  3.6 KB  |  92 lines
  1. 10  '****** MENU
  2. 12  A$=INKEY$:IF LEN(A$)>0 THEN IF ASC(A$)=27 THEN SYSTEM
  3. 15  DIM COLA(21),COLB(21)
  4. 20  KEY OFF:LOCATE ,,0:COLOR ,,0:CAPSPOSX%=25:CAPSPOSY%=68:NUMPOSX%=25:NUMPOSY%=79:CAPSLAST%=2:NUMLAST%=2:P$="  "
  5. 25  C$="M":GOSUB 700 'Change to C$="C" to get a color screen for this program
  6. 30  CLS:F$=SPACE$(12):CLS:COLOR 7,0:FILES"*.BAS":DOS$=CHR$(SCREEN(1,2))+CHR$(SCREEN(1,3)):W=13:YY=1:IF DOS$=":\" THEN YY=2:W=18
  7. 40  GOTO 60
  8. 50  FOR L=1 TO 12:MID$(F$,L)=CHR$(SCREEN(Y,X+L-1)):NEXT L:LOCATE Y,X:COLOR 0,COLA(3):PRINT F$;:COLOR 7,0:LOCATE YO,XO:RETURN
  9. 60  F$=SPACE$(12):X=1:Y=YY:XO=POS(0):YO=CSRLIN:GOSUB 50:YL=YO-1
  10. 70  PRINT:COLOR COLA(2),0:PRINT"  Press ";:COLOR COLB(2),COLA(9):PRINT "L";:COLOR COLA(2),0:PRINT " to load or ";
  11. 75  COLOR COLB(2),COLA(9):PRINT "Enter ";CHR$(17);CHR$(196);CHR$(217);:COLOR COLA(2),0: PRINT " to run ";:COLOR 0,COLA(3):PRINT"highlighted";:COLOR COLA(2),0:PRINT"-lettered program,"
  12. 80  PRINT TAB(10);"or ";:COLOR COLB(2),COLA(9):PRINT CHR$(24);" ";CHR$(25);" ";CHR$(26);" ";CHR$(27);:COLOR COLA(2),0:PRINT " key to move to a different program name."
  13. 85  PRINT TAB(23);"Press ";:COLOR 0,COLA(3):PRINT "Esc";:COLOR COLA(2),0:PRINT " to return to DOS."
  14. 90  XO=POS(0):YO=CSRLIN
  15. 100  I$="":WHILE I$="":I$=INKEY$:GOSUB 1000:WEND
  16. 120  I=ASC(I$)
  17. 130  IF I=66 OR I=98 THEN CLS:END
  18. 140  IF I=27 THEN COLOR 7,0:CLS:SYSTEM
  19. 150  IF LEN(I$)=1 THEN 210
  20. 160  C=ASC(RIGHT$(I$,1))
  21. 170  IF C=75 THEN GOSUB 230:GOTO 100 'curser left
  22. 180  IF C=77 THEN GOSUB 240:GOTO 100 'curser right
  23. 190  IF C=80 THEN GOSUB 250:GOTO 100 'curser down
  24. 200  IF C=72 THEN GOSUB 260:GOTO 100 'curser up
  25. 210  IF I$="L" OR I$="l" THEN CLOSE : COLOR ,,0 :CLS : KEY ON : LOAD F$ ELSE IF I=13 THEN CLOSE : CLS : RUN F$
  26. 220  SOUND 400,0.5:GOTO 100
  27. 230  IF X>W THEN LOCATE Y,X:COLOR 7,0:PRINT F$;:X=X-W:GOSUB 50:GOTO 270 ELSE GOSUB 540 : RETURN
  28. 240  IF X<54 THEN LOCATE Y,X:COLOR 7,0:PRINT F$;:X=X+W:GOSUB 50:GOTO 270 ELSE GOSUB 380: RETURN
  29. 250  IF Y<YO-(4+YY) THEN LOCATE Y,X:COLOR 7,0:PRINT F$;:Y=Y+1:GOSUB 50:GOTO 270 ELSE GOSUB 540 : RETURN
  30. 260  IF Y>YY THEN LOCATE Y,X:COLOR 7,0:PRINT F$;:Y=Y-1:GOSUB 50:GOTO 270 ELSE BEEP : RETURN
  31. 270  IF LEFT$(F$,1)<>SPACE$(1) AND ASC(F$)<> 255 THEN RETURN
  32. 280  GOSUB 310
  33. 290  IF C=80 THEN C=72 : GOTO 260
  34. 300  IF C=77 THEN C=75 : GOTO 230
  35. 310  'Phasor sound
  36. 320  FOR T=1 TO 3
  37. 330  FOR F=1800 TO 300 STEP - 100
  38. 340  SOUND F, 0.1
  39. 350  NEXT
  40. 360  NEXT
  41. 370  RETURN
  42. 380  'bird sound
  43. 390  FOR K=1 TO 2
  44. 400  FOR J=1 TO 2
  45. 410  FOR I=2600 TO 2200 STEP -50
  46. 420  SOUND I, 0.15
  47. 430  NEXT
  48. 440  NEXT
  49. 450  D1=300:GOSUB 610
  50. 460  NEXT
  51. 470  D1=400:GOSUB 610
  52. 480  FOR J=1 TO 4
  53. 490  FOR I=2200 TO 2900 STEP 50
  54. 500  SOUND I, 0.1
  55. 510  NEXT
  56. 520  NEXT
  57. 530  RETURN
  58. 540  'alarm sound
  59. 550  FOR T=1 TO 3
  60. 560  FOR F=500 TO 1400 STEP 20
  61. 570  SOUND F, 0.35
  62. 580  NEXT
  63. 590  NEXT
  64. 600  RETURN
  65. 610  FOR D=1 TO D1:NEXT:RETURN
  66. 700  '***** Subroutine to determine if color is to be displayed. See line 25
  67. 710  '
  68. 720  FOR J=0 TO 20:COLA(J)=7:COLB(J)=0:NEXT
  69. 730  IF C$="C" THEN FOR J=0 TO 20:COLA(J)=J:COLB(J)=J:NEXT
  70. 740  RETURN
  71. 1000  '  * Subroutine to check num lock status *
  72. 1010  IF CAPSLAST%=2 THEN LOCATE CAPSPOSX%,CAPSPOSY%-5,0:COLOR COLB(2),COLA(9):PRINT "CAPS:";:LOCATE NUMPOSX%,NUMPOSY%-4:PRINT "NUM:";:COLOR 7,0
  73. 1015  PTIME$=DATE$+"   "+TIME$+" AM":T=VAL(LEFT$(TIME$,2)):IF T>12 THEN RSET P$=MID$(STR$(T-12),2):MID$(PTIME$,14,2)=P$:MID$(PTIME$,23,2)="PM"
  74. 1020  LOCATE 25,24,0:COLOR COLB(2),COLA(9):PRINT PTIME$;:COLOR 7,0
  75. 1030  POSX%=CSRLIN     '        determine present cursor line
  76. 1040  POSY%=POS(0)     '        determine present cursor position in line
  77. 1050  DEF SEG=64       '      )
  78. 1060     KB1%=PEEK(23) '      ) peek to determine keyboard status
  79. 1070     KB2%=PEEK(24) '      )
  80. 1080  DEF SEG          '      )
  81. 1090  IF (KB1% AND 64)=64 THEN CAPSLOCK%=1 ELSE CAPSLOCK%=0 ' check status of Caps Lock key
  82. 1100  IF (KB1% AND 1)=1 OR (KB1% AND 2)=2 THEN IF CAPSLOCK%=0 THEN CAPSLOCK%=1 ELSE CAPSLOCK%=0 'see if either shift key is depressed
  83. 1110  IF (KB1% AND 32)=32 THEN NUMLOCK%=1 ELSE NUMLOCK%=0 ' check status of Num Llock key
  84. 1120  IF (KB1% AND 1)=1 OR (KB1% AND 2)=2 THEN IF NUMLOCK%=0 THEN NUMLOCK%=1 ELSE NUMLOCK%=0 ' see if either shift key is depressed
  85. 1130  IF CAPSLAST%<>CAPSLOCK% THEN LOCATE CAPSPOSX%,CAPSPOSY%,0:COLOR 0,COLA(3):IF CAPSLOCK%=1 THEN PRINT CHR$(24); ELSE PRINT CHR$(25);'up or down arrow for Caps status
  86. 1140  IF NUMLAST%<>NUMLOCK% THEN LOCATE NUMPOSX%,NUMPOSY%,0:COLOR 0,COLA(3):IF NUMLOCK%=1 THEN PRINT CHR$(24); ELSE PRINT CHR$(25);'up arrow or down arrow for Num status
  87. 1150  NUMLAST%=NUMLOCK%
  88. 1160  CAPSLAST%=CAPSLOCK%
  89. 1170  COLOR 7,0
  90. 1180  LOCATE POSX%,POSY%,1 're-locate and turn on the cursor
  91. 1190  RETURN 'end of subroutine
  92.